home *** CD-ROM | disk | FTP | other *** search
VERSION 5.00 Begin VB.Form FrmGameScreen BackColor = &H00000000& Caption = "GameScreen" ClientHeight = 4800 ClientLeft = 165 ClientTop = 1320 ClientWidth = 9480 ForeColor = &H00FF0000& KeyPreview = -1 'True LinkTopic = "Form1" ScaleHeight = 320 ScaleMode = 3 'Pixel ScaleWidth = 632 StartUpPosition = 2 'CenterScreen Visible = 0 'False Begin VB.CommandButton CmdRules Caption = "&Rules" Height = 735 Left = 120 TabIndex = 12 Top = 720 Width = 1095 End Begin VB.CommandButton CmdQuit Caption = "&Quit" Height = 615 Left = 120 TabIndex = 11 Tag = "SV" ToolTipText = "I've ad enuff" Top = 1440 Width = 1095 End Begin VB.PictureBox PicRollUp Appearance = 0 'Flat BackColor = &H80000002& BorderStyle = 0 'None DragMode = 1 'Automatic ForeColor = &H80000008& Height = 375 Left = 7680 ScaleHeight = 25 ScaleMode = 3 'Pixel ScaleWidth = 105 TabIndex = 7 Tag = "SV" ToolTipText = "Move Me!" Top = 3000 Width = 1575 Begin VB.CommandButton cmdDragenable Caption = "1" Height = 255 Left = 1080 TabIndex = 10 ToolTipText = "Stick to Screen" Top = 0 Width = 255 End Begin VB.CommandButton CmdToggle Caption = "X" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 1320 TabIndex = 9 ToolTipText = "Toggle HighScore" Top = 0 Width = 255 End Begin VB.Label LblRollupCaption Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "HIGHSCORE" ForeColor = &H8000000E& Height = 255 Left = 0 TabIndex = 8 Tag = "SV" Top = 0 Width = 1095 End End Begin VB.PictureBox PicClock Appearance = 0 'Flat AutoRedraw = -1 'True BackColor = &H00000000& BorderStyle = 0 'None ForeColor = &H80000008& Height = 1335 Left = 8040 ScaleHeight = 89 ScaleMode = 3 'Pixel ScaleWidth = 89 TabIndex = 6 Tag = "SV" Top = 720 Visible = 0 'False Width = 1335 Begin VB.Line LinLongHand BorderColor = &H000000FF& Tag = "SV" X1 = 48 X2 = 48 Y1 = 8 Y2 = 40 End Begin VB.Line LinPointerLeft BorderColor = &H000000FF& Tag = "SV" X1 = 48 X2 = 40 Y1 = 8 Y2 = 24 End Begin VB.Line LinPointerRight BorderColor = &H000000FF& Tag = "SV" X1 = 48 X2 = 56 Y1 = 8 Y2 = 24 End Begin VB.Shape ShpClockDot BorderStyle = 0 'Transparent FillColor = &H0200FF00& FillStyle = 0 'Solid Height = 255 Left = 720 Shape = 3 'Circle Tag = "SV" Top = 600 Visible = 0 'False Width = 135 End End Begin VB.Timer TmrStart Interval = 50 Left = 1680 Top = 3480 End Begin VB.Timer TmrEnd Enabled = 0 'False Interval = 100 Left = 1200 Top = 3480 End Begin VB.CommandButton CmdHiScore Caption = "&HiScore" Height = 615 Left = 120 TabIndex = 1 Tag = "SV" Top = 120 Visible = 0 'False Width = 1095 End Begin VB.Timer TmrEnergy1 Enabled = 0 'False Interval = 100 Left = 240 Top = 3120 End Begin VB.Timer TmrClock Enabled = 0 'False Interval = 1000 Left = 720 Top = 3480 End Begin VB.Timer TmrPlayerMissile Enabled = 0 'False Interval = 20 Left = 240 Top = 3480 End Begin VB.Timer TmrMoveAliens Enabled = 0 'False Interval = 150 Left = 240 Top = 2640 End Begin VB.Timer TmrMissileAnimation2 Enabled = 0 'False Interval = 50 Left = 240 Top = 2160 End Begin VB.Label lblHiScore Alignment = 2 'Center BackColor = &H80000002& ForeColor = &H8000000E& Height = 2115 Left = 7680 TabIndex = 5 Top = 3360 Visible = 0 'False Width = 1605 End Begin VB.Image Imgball Height = 240 Index = 4 Left = 6225 Picture = "clcycbitbltform1.frx":0000 Top = 2040 Visible = 0 'False Width = 240 End Begin VB.Image Imgball Height = 240 Index = 3 Left = 5760 Picture = "clcycbitbltform1.frx":014A Top = 2040 Visible = 0 'False Width = 240 End Begin VB.Image Imgball Height = 240 Index = 2 Left = 5400 Picture = "clcycbitbltform1.frx":0294 Top = 2040 Visible = 0 'False Width = 240 End Begin VB.Image Imgball Height = 240 Index = 1 Left = 5040 Picture = "clcycbitbltform1.frx":03DE Top = 2040 Visible = 0 'False Width = 240 End Begin VB.Image Imgball Height = 240 Index = 0 Left = 3360 Picture = "clcycbitbltform1.frx":0528 Tag = "SV" Top = 1440 Visible = 0 'False Width = 240 End Begin VB.Image ImgWalker Appearance = 0 'Flat Height = 480 Index = 9 Left = 7080 Picture = "clcycbitbltform1.frx":0672 Top = 1920 Visible = 0 'False Width = 480 End Begin VB.Image ImgGuidedMissile Height = 240 Index = 2 Left = 8760 Picture = "clcycbitbltform1.frx":097C Top = 2520 Visible = 0 'False Width = 120 End Begin VB.Image ImgGuidedMissile Height = 240 Index = 1 Left = 8640 Picture = "clcycbitbltform1.frx":0A3E Top = 2520 Visible = 0 'False Width = 60 End Begin VB.Image ImgGuidedMissile Height = 240 Index = 0 Left = 8400 Picture = "clcycbitbltform1.frx":0B00 Top = 2520 Visible = 0 'False Width = 60 End Begin VB.Image ImgWalker Appearance = 0 'Flat Height = 480 Index = 8 Left = 7440 Picture = "clcycbitbltform1.frx":0BC2 Top = 1440 Visible = 0 'False Width = 480 End Begin VB.Image ImgWalker Appearance = 0 'Flat Height = 480 Index = 7 Left = 6960 Picture = "clcycbitbltform1.frx":0ECC Top = 1440 Visible = 0 'False Width = 480 End Begin VB.Image ImgWalker Appearance = 0 'Flat Height = 480 Index = 6 Left = 6600 Picture = "clcycbitbltform1.frx":11D6 Top = 1320 Visible = 0 'False Width = 480 End Begin VB.Image ImgWalker Appearance = 0 'Flat Height = 480 Index = 5 Left = 7440 Picture = "clcycbitbltform1.frx":14E0 Top = 840 Visible = 0 'False Width = 480 End Begin VB.Image ImgWalker Appearance = 0 'Flat Height = 480 Index = 4 Left = 6960 Picture = "clcycbitbltform1.frx":17EA Top = 840 Visible = 0 'False Width = 480 End Begin VB.Image ImgWalker Appearance = 0 'Flat Height = 480 Index = 3 Left = 6600 Picture = "clcycbitbltform1.frx":1AF4 Top = 840 Visible = 0 'False Width = 480 End Begin VB.Image ImgWalker Appearance = 0 'Flat Height = 480 Index = 2 Left = 7560 Picture = "clcycbitbltform1.frx":1DFE Top = 240 Visible = 0 'False Width = 480 End Begin VB.Image ImgWalker Appearance = 0 'Flat Height = 480 Index = 1 Left = 7080 Picture = "clcycbitbltform1.frx":2108 Top = 240 Visible = 0 'False Width = 480 End Begin VB.Image ImgWalker Appearance = 0 'Flat Height = 480 Index = 0 Left = 6600 Picture = "clcycbitbltform1.frx":2412 Top = 240 Visible = 0 'False Width = 480 End Begin VB.Label LblTime Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "0:0" ForeColor = &H020000FF& Height = 495 Left = 8040 TabIndex = 4 Top = 2160 Visible = 0 'False Width = 1455 End Begin VB.Label lblEndGame Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "YOUR DEAD SUCKER!!!" BeginProperty Font Name = "MS Sans Serif" Size = 24 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H020000FF& Height = 1335 Left = 2640 TabIndex = 3 Top = 240 Visible = 0 'False Width = 3915 End Begin VB.Image ImgPlayerMissile Height = 240 Index = 4 Left = 8040 Picture = "clcycbitbltform1.frx":271C Top = 2280 Visible = 0 'False Width = 240 End Begin VB.Image ImgPlayerMissile Height = 240 Index = 3 Left = 8280 Picture = "clcycbitbltform1.frx":2866 Top = 2520 Visible = 0 'False Width = 60 End Begin VB.Label lblScore Alignment = 2 'Center BackStyle = 0 'Transparent BorderStyle = 1 'Fixed Single Caption = "Lives 3" ForeColor = &H020000FF& Height = 375 Index = 5 Left = 8160 TabIndex = 2 Tag = "SV" Top = 360 Visible = 0 'False Width = 1335 End Begin VB.Image ImgAlien Height = 240 Index = 16 Left = 5040 Picture = "clcycbitbltform1.frx":2928 Tag = "SV" Top = 1200 Visible = 0 'False Width = 240 End Begin VB.Image ImgAlien Height = 240 Index = 15 Left = 4320 Picture = "clcycbitbltform1.frx":2A72 Tag = "SV" Top = 1170 Visible = 0 'False Width = 240 End Begin VB.Image ImgAlien Height = 240 Index = 14 Left = 3720 Picture = "clcycbitbltform1.frx":2BBC Tag = "SV" Top = 1080 Visible = 0 'False Width = 240 End Begin VB.Image ImgAlien Height = 240 Index = 13 Left = 3000 Picture = "clcycbitbltform1.frx":2D06 Tag = "SV" Top = 1080 Visible = 0 'False Width = 240 End Begin VB.Image ImgAlien Height = 240 Index = 12 Left = 2280 Picture = "clcycbitbltform1.frx":2E50 Tag = "SV" Top = 1080 Visible = 0 'False Width = 240 End Begin VB.Image ImgAlien Height = 240 Index = 11 Left = 1560 Picture = "clcycbitbltform1.frx":2F9A Tag = "SV" Top = 1080 Visible = 0 'False Width = 240 End Begin VB.Image ImgPlayer Height = 480 Index = 5 Left = 5880 Picture = "clcycbitbltform1.frx":30E4 Top = 4200 Visible = 0 'False Width = 480 End Begin VB.Image imgAlienMissile Height = 240 Left = 5040 Picture = "clcycbitbltform1.frx":33EE Top = 3120 Visible = 0 'False Width = 120 End Begin VB.Image img100 Height = 240 Index = 3 Left = 6000 Picture = "clcycbitbltform1.frx":34F8 Top = 3360 Visible = 0 'False Width = 240 End Begin VB.Image img100 Height = 240 Index = 2 Left = 5640 Picture = "clcycbitbltform1.frx":3642 Top = 3360 Visible = 0 'False Width = 240 End Begin VB.Image img100 Height = 240 Index = 1 Left = 5280 Picture = "clcycbitbltform1.frx":378C Top = 3360 Visible = 0 'False Width = 240 End Begin VB.Image img100 Height = 240 Index = 0 Left = 4920 Picture = "clcycbitbltform1.frx":38D6 Top = 3360 Visible = 0 'False Width = 240 End Begin VB.Image ImgPlayer Height = 480 Index = 4 Left = 5280 Picture = "clcycbitbltform1.frx":3A20 Top = 4200 Visible = 0 'False Width = 480 End Begin VB.Image ImgPlayer Height = 480 Index = 3 Left = 4800 Picture = "clcycbitbltform1.frx":3D2A Top = 4200 Visible = 0 'False Width = 480 End Begin VB.Image ImgPlayer Height = 480 Index = 2 Left = 4320 Picture = "clcycbitbltform1.frx":4034 Top = 4200 Visible = 0 'False Width = 480 End Begin VB.Image ImgPlayer Height = 480 Index = 1 Left = 3720 Picture = "clcycbitbltform1.frx":433E Top = 4200 Visible = 0 'False Width = 480 End Begin VB.Image ImgAlienPic Height = 240 Index = 2 Left = 960 Picture = "clcycbitbltform1.frx":4648 Top = 4200 Visible = 0 'False Width = 240 End Begin VB.Image ImgPlayerMissile Height = 240 Index = 2 Left = 8160 Picture = "clcycbitbltform1.frx":4792 Top = 2640 Visible = 0 'False Width = 60 End Begin VB.Image ImgPlayerMissile Height = 240 Index = 1 Left = 8040 Picture = "clcycbitbltform1.frx":4854 Top = 2520 Visible = 0 'False Width = 60 End Begin VB.Image ImgPlayerMissile Height = 240 Index = 0 Left = 7080 Picture = "clcycbitbltform1.frx":4916 Top = 2760 Visible = 0 'False Width = 60 End Begin VB.Image ImgPlayer Height = 480 Index = 0 Left = 3000 Picture = "clcycbitbltform1.frx":49D8 Tag = "SV" ToolTipText = "ALT+up arrow to fire" Top = 4200 Width = 480 End Begin VB.Image ImgAlien Height = 240 Index = 10 Left = 4680 Picture = "clcycbitbltform1.frx":4CE2 Tag = "SV" Top = 720 Visible = 0 'False Width = 240 End Begin VB.Image ImgAlien Height = 240 Index = 9 Left = 3960 Picture = "clcycbitbltform1.frx":4E2C Tag = "SV" Top = 720 Visible = 0 'False Width = 240 End Begin VB.Image ImgAlien Height = 240 Index = 8 Left = 3360 Picture = "clcycbitbltform1.frx":4F76 Tag = "SV" Top = 720 Visible = 0 'False Width = 240 End Begin VB.Image ImgAlien Height = 240 Index = 7 Left = 2640 Picture = "clcycbitbltform1.frx":50C0 Tag = "SV" Top = 720 Visible = 0 'False Width = 240 End Begin VB.Image ImgAlien Height = 240 Index = 6 Left = 1920 Picture = "clcycbitbltform1.frx":520A Tag = "SV" Top = 720 Visible = 0 'False Width = 240 End Begin VB.Image ImgAlien Height = 240 Index = 5 Left = 5040 Picture = "clcycbitbltform1.frx":5354 Top = 120 Visible = 0 'False Width = 240 End Begin VB.Image ImgAlien Height = 240 Index = 4 Left = 4320 Picture = "clcycbitbltform1.frx":549E Top = 120 Visible = 0 'False Width = 240 End Begin VB.Image ImgAlien Height = 240 Index = 3 Left = 3720 Picture = "clcycbitbltform1.frx":55E8 Tag = "SV" Top = 120 Visible = 0 'False Width = 240 End Begin VB.Image ImgAlienPic Height = 240 Index = 1 Left = 600 Picture = "clcycbitbltform1.frx":5732 Top = 4080 Visible = 0 'False Width = 240 End Begin VB.Image ImgAlien Height = 240 Index = 2 Left = 3000 Picture = "clcycbitbltform1.frx":587C Tag = "SV" Top = 120 Visible = 0 'False Width = 240 End Begin VB.Image ImgAlien Height = 240 Index = 1 Left = 2280 Picture = "clcycbitbltform1.frx":59C6 Tag = "SV" Top = 120 Visible = 0 'False Width = 240 End Begin VB.Image ImgAlien Height = 240 Index = 0 Left = 1560 Picture = "clcycbitbltform1.frx":5B10 Tag = "SV" Top = 120 Visible = 0 'False Width = 240 End Begin VB.Image ImgAlienPic Height = 240 Index = 0 Left = 360 Picture = "clcycbitbltform1.frx":5C5A Top = 4080 Visible = 0 'False Width = 240 End Begin VB.Label lblScore Alignment = 2 'Center BackStyle = 0 'Transparent BorderStyle = 1 'Fixed Single Caption = "0" ForeColor = &H020000FF& Height = 375 Index = 4 Left = 8160 TabIndex = 0 Tag = "SV" Top = 0 Visible = 0 'False Width = 1335 End Attribute VB_Name = "FrmGameScreen" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False '********************SPACEINVADERS----by Sergio Perciballi*********** ' Date 14/Nov/1998 email oigres@postmaster.co.uk 'Program ---recreation of classic 1979 game;animated splash 'This module====FrmGameScreen------Game Screen------------- 'Version5---added-:playerslip;clock;3 bullets on screen 'aliens improved redraw by visible/false/true on every move 'variables need to be declared 'New!!! detectcollision routine in module-simpler code 'eccentric alien movements!!!! 'version 6- new highscore rollup 'Last Version-30/jan/99- separate FrmScore containing players scores,names 'Better collision Detection: player type in .bas module public variable Option Explicit Dim dx, dy, x2, alienNo, alienDx, GmPic, Pic As Integer Dim missile, barrel(2) As Integer 'missile index; barrel to keep them in Dim dead(16), allkilled As Boolean Dim score, lives, BulletIndex, BulletOff, plyrmssl Dim alienmovetype As Long Dim hiscore(19) As Long 'array to store scores Dim hiname(19) As String ' to store names in hi score Dim xm, ym ' mouse co-ordinates to store for rollup Dim sec, ballpic 'Public Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" (ByVal hDC As Long, ByVal lpsz As String, ByVal n As Long, lpRect As RECT, ByVal un As Long, lpDrawTextParams As DRAWTEXTPARAMS) As Long Dim NoAliens, energy, PlayerDx As Long 'possible optimize as long Dim alienfire, CanFire, StopMoving, walker, FireGuidedMissile As Boolean Dim x 'for clock Private Sub CmdRules_Click() 'display rules in message box MsgBox "Alt+right arrow to move ->" & vbCr _ & "Alt+Left arrow to move <-" & vbCr _ & "Alt+Up arrow to fire ^" End Sub 'cmdrules Private Sub Form_Load() 'form_load also executes when we unload then show form Dim index 'FrmGameScreen.Show 'slip of player StopMoving = False energy = 5: score = 0 plyrmssl = 0: FireGuidedMissile = False: GmPic = 1 'setup variables walker = False: CanFire = True: alienfire = False: NoAliens = 16: '0-16 alienmovetype = 2 'start up down BulletIndex = 0: BulletOff = 0: allkilled = False Randomize: Pic = 0: sec = 0: ballpic = 1 missile = 0: For index = 0 To 2: barrel(index) = 0: Next 'array for dead aliens For index = 0 To 16: dead(index) = False: Next lives = 3 'direction vectors for change in ball movement dx = 8: dy = 8 'hiscore table -1000 low for comparison For index = 0 To 19: hiscore(index) = -1000: Next 'players names For index = 0 To 3 players(index).name = "player" & index + 1 players(index).score = 0 'initial value of labels FrmScores.lblPlayer(index).Caption = players(index).name FrmScores.lblScore(index).Caption = players(index).score Next alienDx = 8 End Sub Private Sub cmdDragenable_Click() 'rollup for hiscore if you click button 'then make it stick to screen -like corel draw! palettes If PicRollUp.DragMode = 1 Then PicRollUp.DragMode = 0 'no dragable cmdDragenable.Caption = "0" Else PicRollUp.DragMode = 1 'yes dragable cmdDragenable.Caption = "1" End If End Sub Private Sub PicRollUp_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) 'position of mouse when you click and drag-mouse move seems 'to stop when you drag xm = x: ym = y End Sub Private Sub CmdToggle_Click() lblHiScore.Visible = Not lblHiScore.Visible 'invert visibility End Sub Private Sub Form_DragDrop(Source As Control, x As Single, y As Single) 'move dragged component :place label just below it Source.Left = x - xm Source.Top = y - ym lblHiScore.Left = x - xm lblHiScore.Top = y + PicRollUp.Height - ym End Sub 'formDragdrop Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) 'move bat move if alt shift or control and arrow keys 'keycode lets me get arrow keys and test shift 'need to have key up and key down event handled 'vbKeyLeft-left arrow; vbKeyRight-rightarrow; vbKeyUp are codes for arrow keys constants ImgPlayer(0).Visible = False If Shift And vbAltMask Then ' if alt key down If KeyCode = vbKeyRight And ImgPlayer(0).Left < 600 Then ImgPlayer(0).Left = ImgPlayer(0).Left + energy ImgPlayer(0).Picture = ImgPlayer(3).Picture PlayerDx = 0 'move with increase in energy If energy <= 20 Then energy = energy + 1 End If If KeyCode = vbKeyLeft And ImgPlayer(0).Left > 0 Then ImgPlayer(0).Left = ImgPlayer(0).Left - energy ImgPlayer(0).Picture = ImgPlayer(2).Picture PlayerDx = -1 'move with increase in energy If energy <= 20 Then energy = energy + 1 End If 'move bat; will be firing gun If KeyCode = vbKeyUp Then ImgPlayer(0).Picture = ImgPlayer(4) fireplayermissile End If End If ImgPlayer(0).Visible = True StopMoving = False End Sub Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer) 'keycode lets me get arrow keys and test shift 'vbKeyLeft vbKeyRight vbKeyUp are codes for arrow keys constants ImgPlayer(0).Visible = False If Shift And vbAltMask Then If KeyCode = vbKeyRight And ImgPlayer(0).Left < 600 Then 'ImgPlayer(0).Left = ImgPlayer(0).Left + energy ImgPlayer(0).Picture = ImgPlayer(1).Picture PlayerDx = 0 End If If KeyCode = vbKeyLeft And ImgPlayer(0).Left > 0 Then 'ImgPlayer(0).Left = ImgPlayer(0).Left - energy PlayerDx = -1 ImgPlayer(0).Picture = ImgPlayer(1).Picture End If 'restore player pic If KeyCode = vbKeyUp Then ImgPlayer(0).Picture = ImgPlayer(1) 'fireplayermissile End If End If ImgPlayer(0).Visible = True StopMoving = True End Sub Private Sub fireplayermissile() 'fire playermissile 'limited to 3 shots on screen 'takeout bullet If CanFire Then If BulletIndex < 3 Then If BulletOff <= 3 Then ImgPlayerMissile(BulletIndex).Picture = ImgPlayerMissile(3).Picture 'place playermissile above player ImgPlayerMissile(BulletIndex).Left = ImgPlayer(0).Left + 8 ImgPlayerMissile(BulletIndex).Top = ImgPlayer(0).Top - ImgPlayerMissile(BulletIndex).Height ImgPlayerMissile(BulletIndex).Visible = True BulletIndex = BulletIndex + 1 End If End If End If If BulletIndex >= 3 Then CanFire = False End If End Sub Private Sub TmrEnergy1_Timer() 'if stopkeypress then move player reducing his energy If StopMoving Then If energy > 0 Then ImgPlayer(0).Visible = False If PlayerDx = -1 Then If ImgPlayer(0).Left >= 0 Then ImgPlayer(0).Left = ImgPlayer(0).Left - energy Else If ImgPlayer(0).Left <= ScaleWidth Then ImgPlayer(0).Left = ImgPlayer(0).Left + energy End If energy = energy * 90 / 100 ImgPlayer(0).Visible = True Else 'drained of energy energy = 5 StopMoving = False End If End If End Sub Private Sub TmrClock_Timer() Dim rad, cradius, cx, cy Dim degreetorad, clockangle, offsetp Dim radius, radiusp, handx, handy 'cradius=radius of clock face cradius = 25: cx = 50: cy = 50 'place dot on face of clock ShpClockDot.Left = cx - (ShpClockDot.Width / 2) ShpClockDot.Top = cy - (ShpClockDot.Height / 2) 'draw lines on face of clock PicClock.Visible = False 'container off For x = 0 To 360 'degrees rad = x / 180 * 3.14 + 3.9 'degree to radians + offset 3.9 If x Mod 6 = 0 Then 'every 6 degrees= 60 divisions PicClock.PSet ((cradius * Cos(rad)) - (cradius * Sin(rad)) + cx, (cradius * Sin(rad)) + (cradius * Cos(rad)) + cy), &HFFF00 End If If x Mod 30 = 0 Then 'every 30 degrees= 12 divisions(12 numbers on clock) PicClock.CurrentX = (20 * Cos(rad)) - (20 * Sin(rad)) + cx PicClock.CurrentY = (20 * Sin(rad)) + (20 * Cos(rad)) + cy PicClock.Line -((cradius * Cos(rad)) - (cradius * Sin(rad)) + cx, (cradius * Sin(rad)) + (cradius * Cos(rad)) + cy), &HFF00 End If 'longer line on clock dial in green Next 'turn off lables ,hands LblTime.Visible = False 'LinLongHand.Visible = False 'LinPointerLeft.Visible = False 'LinPointerRight.Visible = False radius = 20: radiusp = 15: offsetp = 0.1 clockangle = (6 * sec) '60sec 6*60=360=degrees degreetorad = (clockangle / 180) * 3.14 + 3.9 'change degreetorad 'minutes and seconds in label \=integer div LblTime.Caption = (sec \ 60) & ":" & (sec Mod 60) LinLongHand.X1 = 50: LinLongHand.Y1 = 50 'end of clock hand near dots handx = (radius * Cos(degreetorad)) - (radius * Sin(degreetorad)) + 50 handy = (radius * Sin(degreetorad)) + (radius * Cos(degreetorad)) + 50 LinLongHand.x2 = handx LinLongHand.Y2 = handy 'left pointer bit LinPointerLeft.X1 = handx: LinPointerLeft.Y1 = handy LinPointerLeft.x2 = (radiusp * Cos(degreetorad - offsetp)) - (radiusp * Sin(degreetorad - offsetp)) + 50 LinPointerLeft.Y2 = (radiusp * Sin(degreetorad - offsetp)) + (radiusp * Cos(degreetorad - offsetp)) + 50 'right pointer bit LinPointerRight.X1 = handx: LinPointerRight.Y1 = handy LinPointerRight.x2 = (radiusp * Cos(degreetorad + offsetp)) - (radiusp * Sin(degreetorad + offsetp)) + 50 LinPointerRight.Y2 = (radiusp * Sin(degreetorad + offsetp)) + (radiusp * Cos(degreetorad + offsetp)) + 50 'turn on lables ,hands PicClock.Visible = True 'container on LblTime.Visible = True 'LinLongHand.Visible = True 'LinPointerLeft.Visible = True 'LinPointerRight.Visible = True sec = sec + 1 'increase every second End Sub 'TmrClock Private Sub TmrEnd_Timer() 'exit prog if click no Static index, counter 'controls=collection of controls on form If index = Controls.Count Then Unload Me 'cleanup Set FrmGameScreen = Nothing End End If 'avoid timers as they can't be made invisible If (TypeOf Controls(index) Is Label) Or (TypeOf Controls(index) Is CommandButton) _ Or (TypeOf Controls(index) Is Image) Or (TypeOf Controls(index) Is PictureBox) _ Then FrmGameScreen.Controls(index).Visible = False End If 'MsgBox "index=" 'Debug.Print index; Controls.Count index = index + 1 End Sub 'TmrEnd Private Sub TmrPlayerMissile_Timer() Dim index, topmissile Static WalkerPic 'PlayerMissile if on screen then 'move up screen 'move alien missile down screen also TurnOnAlienMissile ' call alien missile movers 'playermissile==================== For index = 0 To 2 If ImgPlayerMissile(index).Visible = True Then 'move missile to top of screen ImgPlayerMissile(index).Visible = False ImgPlayerMissile(index).Top = ImgPlayerMissile(index).Top - 6 ImgPlayerMissile(index).Visible = True End If If ImgPlayerMissile(index).Top <= 0 Then If ImgPlayerMissile(index).Visible Then BulletOff = BulletOff + 1 End If ImgPlayerMissile(index).Visible = False End If Next index 'walker animation and move conditions If walker And ImgWalker(0).Visible Then WalkerPic = WalkerPic + 1 If WalkerPic > 8 Then WalkerPic = 1 ImgWalker(0).Visible = False 'draw optimization ImgWalker(0).Picture = ImgWalker(WalkerPic).Picture ImgWalker(0).Move ImgWalker(0).Left + 2 ImgWalker(0).Visible = True If ImgWalker(0).Left > ScaleWidth Then ImgWalker(0).Visible = False walker = False End If End If If FireGuidedMissile Then ImgGuidedMissile(0).Visible = False If ImgGuidedMissile(0).Left > ImgPlayer(0).Left + 8 Then ImgGuidedMissile(0).Left = ImgGuidedMissile(0).Left - 2 End If 'offsets of 8 to center missile If ImgGuidedMissile(0).Left < ImgPlayer(0).Left + 8 Then ImgGuidedMissile(0).Left = ImgGuidedMissile(0).Left + 2 End If If ImgGuidedMissile(0).Top < ImgPlayer(0).Top Then ImgGuidedMissile(0).Top = ImgGuidedMissile(0).Top + 2 End If 'flip pictures If GmPic = 1 Then GmPic = 2 Else GmPic = 1 End If ImgGuidedMissile(0).Picture = ImgGuidedMissile(GmPic).Picture ImgGuidedMissile(0).Visible = True End If End Sub 'TmrPlayerMissile Private Sub TurnOnAlienMissile() Dim index As Integer If alienfire Then index = Int(NoAliens * Rnd) 'see if alien alive If ImgAlien(index).Visible And Not dead(index) Then If imgAlienMissile.Visible = False Then imgAlienMissile.Left = ImgAlien(index).Left imgAlienMissile.Top = ImgAlien(index).Top imgAlienMissile.Visible = True alienfire = False End If End If End If If imgAlienMissile.Visible Then 'move alien missile imgAlienMissile.Visible = False imgAlienMissile.Top = imgAlienMissile.Top + 4 imgAlienMissile.Visible = True If imgAlienMissile.Top > ScaleHeight Then 'if off bottom imgAlienMissile.Visible = False End If End If End Sub 'turnonalienmissile Private Sub TmrMissileAnimation2_Timer() 'alien missile animation 'resetpic 'ImgPlayerMissile(0).Picture = ImgPlayerMissile(3).Picture 'ImgPlayerMissile(0).Top = -1 ImgPlayerMissile(plyrmssl).Visible = False 'me off TmrMissileAnimation2.Enabled = False End Sub 'TmrMissileAnimation2 Private Sub TmrMoveAliens_Timer() 'main moves of aliens Dim shpcenterx, shpcentery, alien Dim index As Long 'optimize? MoveBall ' call ball move and detect subroutines '****************move aliens 3right/left then down ;no of aliens For index = 0 To NoAliens 'if alien alive and on screen If dead(index) = False Then 'test if over sides: move down if over If ImgAlien(index).Left > 500 And alienDx = 8 Then alienDx = -8 AlienDownMove End If If ImgAlien(index).Left < 90 And alienDx = -8 Then alienDx = 8 AlienDownMove End If 'see if aliens level with player - can't kill them so end game If ImgAlien(index).Top >= ImgPlayer(0).Top Then EndGame ("Alien on your level:Another Game?") Exit Sub 'get out of sub End If Else TurnAlienToScore (index) End If 'end if alive 'change picture on aliens------------------------------- If Pic = 0 Then Pic = 1 Else Pic = 0 End If AlienMoveRoutines (index) 'lefttoright circle and half circle moves 'call procs to detect if hit DetectCollisionPlayerMissileAlien (index) DetectCollisionAlienPlayer Next index 'for each alien 'randomly let aliens fire if num=2 'If Int(Rnd * 3) = 2 Then If imgAlienMissile.Visible = False Then alienfire = True End If 'End If If walker = False And Int(Rnd * 51) = 50 Then walker = True ImgWalker(0).Visible = True ImgWalker(0).Left = 80 ImgWalker(0).Top = 10 End If 'fire guided missile If walker = True And FireGuidedMissile = False And Int(Rnd * 51) = 50 Then FireGuidedMissile = True ImgGuidedMissile(0).Visible = True ImgGuidedMissile(0).Left = ImgWalker(0).Left ImgGuidedMissile(0).Top = ImgWalker(0).Top + ImgWalker(0).Height End If End Sub 'TmrMovealiens Private Sub MoveBall() 'move ball, check if center of ball overlaps; not gone past bottom edge If Imgball(0).Left < 0 Then dx = 8: Beep If Imgball(0).Top < 0 Then dy = 8: Beep If Imgball(0).Left + Imgball(0).Width > ScaleWidth Then dx = -8: Beep 'if ball overlaps the player then reverse y direction If detectcol(Imgball(0), ImgPlayer(0)) Then dy = -8 End If 'move ball turn off then on to improve draw speed Imgball(0).Visible = False Imgball(0).Move Imgball(0).Left + dx, Imgball(0).Top + dy 'move through pictures of rotating ball ballpic = ballpic + 1 If ballpic > 4 Then ballpic = 1 Imgball(0).Picture = Imgball(ballpic).Picture 'turn on Imgball(0).Visible = True 'if ball gone past without hit ' end game----------- If Imgball(0).Top > ScaleHeight Then EndGame ("Ball Lost!!! Another Game?") Exit Sub End If End Sub 'MoveBall Private Sub AlienMoveRoutines(ByVal index) Dim yaliendy, xaliendx Static degree 'movement routines of aliens If Not dead(index) Then 'improve draw speed if turn off then on ImgAlien(index).Visible = False 'flip picture of alien 0:=open arms 1:=closed arms ImgAlien(index).Picture = ImgAlienPic(Pic).Picture ' degree = degree + 0.05 If degree > 6.28 Then degree = 0 'generate x move ImgAlien(index).Left = ImgAlien(index).Left + alienDx yaliendy = 5 * Sin(degree + index) + 5 * Cos(degree + index) + ImgAlien(index).Top xaliendx = 5 * Cos(degree + index) - 5 * Sin(degree + index) + ImgAlien(index).Left 'ImgAlien(Index).Top = yaliendy Select Case alienmovetype 'from aliendownmove Case 1 'circle movement ImgAlien(index).Move xaliendx, yaliendy Case 2 'y up and down ImgAlien(index).Move ImgAlien(index).Left, yaliendy Case 3 'straight left to right ImgAlien(index).Move ImgAlien(index).Left End Select ImgAlien(index).Visible = True End If End Sub 'AlienMoveRoutines Private Sub TurnAlienToScore(ByVal index) 'turn alien into score 100 ImgAlien(index).Picture = img100(Int(Rnd * 4)).Picture 'move alien who is now a score -100- up screen If dead(index) Then ImgAlien(index).Visible = False ImgAlien(index).Top = ImgAlien(index).Top - 5 ImgAlien(index).Visible = True End If 'check and make invisible if dead off screen If ImgAlien(index).Top < 0 Then ImgAlien(index).Visible = False End If 'number100 if off screen upwards End Sub 'turnalientoscore Private Sub DetectCollisionPlayerMissileAlien(alienindex) Dim mcx, mcy, index, ImgGmcx, ImgGmcy, killed As Long 'check aliens if visible if hit by playermissile If dead(alienindex) = False Then For index = 0 To 2 'cycle through missiles If ImgPlayerMissile(index).Visible Then 'detect collision-playermissile and alien If detectcol(ImgPlayerMissile(index), ImgAlien(alienindex)) _ Then 'make disapear=kill 'hide missile ImgPlayerMissile(index).Visible = False 'reduce bullets :only 3 fired per time BulletOff = BulletOff + 1 ImgPlayerMissile(index).Top = -1 'picture of dead alien ImgAlien(alienindex).Picture = ImgAlienPic(2).Picture dead(alienindex) = True 'list of dead aliens 'killed = killed + 1 'record alien dead 0..16 Debug.Print "killed=" 'detect if all aliens dead here For x = 0 To 16 If dead(x) Then killed = killed + 1 End If Next x If killed = 17 Then '0..16 EndGame ("You Are A Winner: Another Game?") Exit Sub End If score = score + 100 lblScore(4).Caption = score End If 'if player hits alien 'if hit guidedmissile If ImgGuidedMissile(0).Visible Then 'col detect playermissile and guidedmissile If detectcol(ImgPlayerMissile(index), ImgGuidedMissile(0)) _ Then 'playermissile hits guided missile ImgGuidedMissile(0).Visible = False FireGuidedMissile = False 'adjust playermissiles ImgPlayerMissile(index).Visible = False 'wait for all bullets to be off BulletOff = BulletOff + 1 ImgPlayerMissile(index).Top = -1 score = score + 1000 lblScore(4).Caption = score End If End If If ImgWalker(0).Visible Then 'col detection imgplayermissile and walker If detectcol(ImgPlayerMissile(index), ImgWalker(0)) _ Then 'player missile hits walker ImgWalker(0).Picture = ImgWalker(9).Picture ImgWalker(0).Visible = False walker = False ImgPlayerMissile(index).Visible = False ImgPlayerMissile(index).Top = -1 BulletOff = BulletOff + 1 End If End If End If 'playermissile visible Next 'missile 0..2 End If 'if alien alive and visible 'limit bullets to 3 If BulletOff >= 3 Then CanFire = True BulletIndex = 0 BulletOff = 0 End If End Sub 'DetectCollisionPlayerMissileAlien Private Sub DetectCollisionAlienPlayer() Dim index, ImgGmcx, ImgGmcy As Long Dim ImgAmicx, ImgAmicy 'alien missile centerx/y 'alien missile center ImgAmicx = imgAlienMissile.Left + (imgAlienMissile.Width / 2) ImgAmicy = imgAlienMissile.Top + (imgAlienMissile.Height / 2) 'col detect alien missile and player 'If ImgAmicx >= ImgPlayer(0).Left And ImgAmicx <= ImgPlayer(0).Left + ImgPlayer(0).Width 'And ImgAmicy >= ImgPlayer(0).Top And ImgAmicy <= ImgPlayer(0).Top + ImgPlayer(0).Height If detectcol(imgAlienMissile, ImgPlayer(0)) _ Then 'alien missile hits player imgAlienMissile.Top = ScaleHeight + 1 imgAlienMissile.Visible = False ImgPlayer(0).Picture = ImgPlayer(5).Picture lives = lives - 1 lblScore(5).Caption = "lives " & lives If lives = 0 Then EndGame ("Lost Lives-Another Game?") Exit Sub End If 'ImgPlayer(0).Picture = ImgPlayer(1).Picture End If 'alien missile center:check if alienmissile hits playermissile 'ImgAmicx = imgAlienMissile.Left + (imgAlienMissile.Width / 2) 'ImgAmicy = imgAlienMissile.Top + (imgAlienMissile.Height / 2) 'checkplayermissiles For index = 0 To 2 'If ImgAmicx >= ImgPlayerMissile(Index).Left And ImgAmicx <= ImgPlayerMissile(Index).Left + ImgPlayerMissile(Index).Width 'And ImgAmicy >= ImgPlayerMissile(Index).Top And ImgAmicy <= ImgPlayerMissile(Index).Top + ImgPlayerMissile(Index).Height If detectcol(imgAlienMissile, ImgPlayerMissile(index)) _ Then 'alien missile hits playermissile imgAlienMissile.Top = ScaleHeight + 1 imgAlienMissile.Visible = False score = score + 50 lblScore(4).Caption = score plyrmssl = index 'which bullet to turn off ImgPlayerMissile(index).Picture = ImgPlayerMissile(4).Picture BulletOff = BulletOff + 1 'delay for visual effect TmrMissileAnimation2.Enabled = True End If Next 'guided missile detect:end game if hits player ' If ImgGuidedMissile(0).Visible Then 'If ImgGmcx >= ImgPlayer(0).Left And ImgGmcx <= ImgPlayer(0).Left + ImgPlayer(0).Width 'And ImgGmcy >= ImgPlayer(0).Top And ImgGmcy <= ImgPlayer(0).Top + ImgPlayer(0).Height If detectcol(ImgGuidedMissile(0), ImgPlayer(0)) _ Then ImgGuidedMissile(0).Visible = False EndGame ("GUIDED DEATH!!-Another Game?") Exit Sub 'added safety '--===bug on guided death must get out of loop ' make guided missile invisible! =solution! End If End If End Sub 'DetectCollisionAlienPlayer Private Sub AlienDownMove() Dim index As Long 'select type of move for alien in alienmovetmr event alienmovetype = Int(Rnd * 3) + 1 'Debug.Print alienmovetype ' 'move alien down screen:triggered by tmralienmove For index = 0 To NoAliens If ImgAlien(index).Visible And dead(index) = False Then ImgAlien(index).Visible = False ImgAlien(index).Move ImgAlien(index).Left, ImgAlien(index).Top + 14 ImgAlien(index).Visible = True End If Next End Sub 'alienMoveDown Private Sub EndGame(msg As String) Dim response Dim counter, index If msg = "You Are A Winner: Another Game?" Then Else lblEndGame.Visible = True ' don't show it if winner End If 'whiteout player pic ImgPlayer(0).Picture = ImgPlayer(5).Picture '16=critical mark icon response = MsgBox(msg, vbYesNo + 16, "--------SPACEINVADERS--------") If response = vbYes Then 'we clicked yes Unload Me: Show 'reload and restart Else lblEndGame.Visible = True lblEndGame.Caption = "GOODBYE!" & Chr$(13) & "closing down" FrmGameScreen.Caption = "GOODBYE!" TmrEnergy1.Enabled = False TmrClock.Enabled = False TmrMissileAnimation2.Enabled = False TmrMoveAliens.Enabled = False TmrPlayerMissile.Enabled = False TmrEnd.Enabled = True 'make invisible all controls and destroy resources End If End Sub 'EndGame Private Sub TmrStart_Timer() Static index 'startmain 'turn on visible controls and timers enabled If (TypeOf Controls(index) Is Label) Or (TypeOf Controls(index) Is CommandButton) _ Or (TypeOf Controls(index) Is Image) Or (TypeOf Controls(index) Is Shape) _ Or (TypeOf Controls(index) Is PictureBox) _ Then 'SV=for controls that Start Visible If Controls(index).Tag = "SV" Then FrmGameScreen.Controls(index).Visible = True End If End If 'strange- controls.count starts at 0 'so controls.count=88 but index 0..87 index = index + 1 If index = Controls.Count Then index = 0 TmrEnergy1.Enabled = True TmrMoveAliens.Enabled = True TmrPlayerMissile.Enabled = True TmrClock.Enabled = True 'turn me off TmrStart.Enabled = False End If End Sub 'TmrStart Private Sub CmdQuit_Click() 'button to quit game screen Unload Me 'resource clean-up Set FrmGameScreen = Nothing End End Sub 'CmdQuit-Click in frmgamescreen Private Sub CmdHiScore_Click() Dim index, x, indexplayer, innum, tempindex As Long ' timer event still sent when form is modal so have to turn them off For index = 0 To Controls.Count - 1 If TypeOf Controls(index) Is Timer Then Controls(index).Enabled = False 'turn all off if timer End If Next FrmScores.Show (vbModal) 'stop everygame to look at score lblHiScore.Caption = "" 'prepare table 'go through players scores; sort scores For indexplayer = 0 To 3 'see if any player got higher score innum = players(indexplayer).score For index = 0 To 19 If innum >= hiscore(index) Then 'shift other values down in array tempindex = index For x = 19 To tempindex + 1 Step -1 'go backwards in array hiscore(x) = hiscore(x - 1) Next hiscore(tempindex) = innum Exit For 'jump out of loop for if higher found End If Next Next indexplayer 'display hi-table in label lblhiscore 'lblHiScore.Visible = True For index = 0 To 3 'display 4 scores from array players() lblHiScore.Caption = lblHiScore.Caption & players(index).name & " : " & players(index).score & vbCrLf Next For index = 4 To 19 'display rest of players lblHiScore.Caption = lblHiScore.Caption & "player " & index & " : " & hiscore(index) & vbCrLf Next End Sub 'CmdHiScore '****************************End FrmGameScreen************************** 
(.txt)